home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Examples / Counter.p < prev    next >
Text File  |  1989-07-02  |  3KB  |  159 lines
  1. Program Counter;
  2.  
  3. {
  4. This program reads a text file, then prints a report telling
  5. you all the words in the file, and how many times each was
  6. used.  It was intended as a demonstration and test of string
  7. stuff and some addressing things.  The other major reason I
  8. wrote it is because I am currently re-writing the compiler's
  9. symbol table stuff, and the two designs I'm thinking about are
  10. binary trees and hash tables.  I am going to use the hash
  11. tables, but I wanted to get familiar with both methods before
  12. I started the actual work.
  13. }
  14.  
  15. {$I ":Include/Ports.i"}
  16. {$I ":Include/Parameters.i"}
  17. {$I ":Include/StringLib.i"}
  18.  
  19. type
  20.     WordRec = Record
  21.     Left,
  22.     Right : ^WordRec;
  23.     Count : Integer;
  24.     Data  : array [0..255] of char;
  25.     end;
  26.     WordPtr = ^WordRec;
  27.  
  28. var
  29.    Root        : WordPtr;
  30.    CurrentChar    : Char;
  31.    InFile    : Text;
  32.    CurrentWord    : String;
  33.    TotalWords    : Integer;
  34.  
  35. Procedure ReadChar;
  36. begin
  37.     if eof(InFile) then
  38.     CurrentChar := Chr(0)
  39.     else
  40.     Read(Infile, CurrentChar);
  41. end;
  42.  
  43. Procedure SkipWhiteSpace;
  44. begin
  45.     while (not eof(Infile)) and (not isalpha(CurrentChar)) do
  46.     ReadChar;
  47. end;
  48.  
  49. Procedure ReadWord;
  50. var
  51.    i : Integer;
  52. begin
  53.     i := 0;
  54.     while isalnum(CurrentChar) do begin
  55.     CurrentWord[i] := CurrentChar;
  56.     i := Succ(i);
  57.     ReadChar;
  58.     end;
  59.     CurrentWord[i] := Chr(0);
  60. end;
  61.  
  62. Procedure EnterWord(rec : WordPtr);
  63. var
  64.     Current : WordPtr;
  65. begin
  66.     if Root = nil then begin
  67.     Root := rec;
  68.     return;
  69.     end;
  70.     Current := Root;
  71.     while true do begin
  72.     if Stricmp(Adr(rec^.Data), Adr(Current^.Data)) < 0 then begin
  73.         if Current^.Left = nil then begin
  74.         Current^.Left := rec;
  75.         return;
  76.         end else
  77.         Current := Current^.Left;
  78.     end else begin
  79.         if Current^.Right = nil then begin
  80.         Current^.Right := rec;
  81.         return;
  82.         end else
  83.         Current := Current^.Right;
  84.     end;
  85.     end;
  86. end;
  87.  
  88. Procedure AddWord(str : String);
  89. var
  90.     rec : WordPtr;
  91. begin
  92.     rec := WordPtr(AllocString(13 + strlen(str)));
  93.     strcpy(Adr(rec^.Data), str);
  94.     rec^.Left := nil;
  95.     rec^.Right := nil;
  96.     rec^.Count := 1;
  97.     EnterWord(rec);
  98. end;
  99.  
  100. Function FindWord(str : String) : WordPtr;
  101. var
  102.     Current : WordPtr;
  103.     Result  : Integer;
  104. begin
  105.     Current := Root;
  106.     while true do begin
  107.     if Current = nil then
  108.         FindWord := nil;
  109.     Result := stricmp(str, Adr(Current^.Data));
  110.     if Result < 0 then
  111.         Current := Current^.Left
  112.     else if Result > 0 then
  113.         Current := Current^.Right
  114.     else
  115.         FindWord := Current;
  116.     end;
  117. end;
  118.  
  119. Procedure Report(W : WordPtr);
  120. begin
  121.     if W <> nil then begin
  122.     Report(W^.Left);
  123.     Writeln(W^.Count, Chr(9), String(Adr(W^.Data)));
  124.     TotalWords := TotalWords + W^.Count;
  125.     Report(W^.Right);
  126.     end;
  127. end;
  128.  
  129. var
  130.     W : WordPtr;
  131.     FileName : String;
  132. begin
  133.     Root := nil;
  134.     CurrentWord := AllocString(128);
  135.     FileName := AllocString(80);
  136.     GetParam(1, FileName);
  137.     if FileName^ = Chr(0) then begin    { No parameter }
  138.     Writeln('Usage: Counter Filename');
  139.     Exit(10);
  140.     end;
  141.     if reopen(FileName, Infile) then begin
  142.     SkipWhiteSpace;
  143.     while not eof(Infile) do begin
  144.         ReadWord;
  145.         SkipWhiteSpace;
  146.         W := FindWord(CurrentWord);
  147.         if W = nil then
  148.         AddWord(CurrentWord)
  149.         else
  150.         W^.Count := Succ(W^.Count);
  151.     end;
  152.     TotalWords := 0;
  153.     Report(Root);
  154.     Writeln('Total Words: ', TotalWords);
  155.     Close(Infile);
  156.     end else
  157.     Writeln('Could not open the input file : ', FileName);
  158. end.
  159.